Otherware/Otherware_1_SB_Development.iso/mac/hypercar/fun/mgcstck.sit/Magic Stack/stack.txt

Text File | 1991-09-04 | 19.5 KB | 606 lines

-- stack: in
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 2
-- first background id: 2760
-- card count: 7
-- first card id: 2847
-- list block id: 2266
-- print block id: 0
-- font table block id: 0
-- style table block id: 0
-- free block count: 0
-- free size: 0 bytes
-- total size: 113280 bytes
-- stack block size: 17920 bytes
-- created by hypercard version: 0x01258000
-- compacted by hypercard version: 0x01258000
-- modified by hypercard version: 0x01258000
-- opened by hypercard version: 0x01258000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x00103854FE543810
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
on openStack
  if the version < 1.2 then
    answer "Sorry. You need Hypercard 1.2 or greater for this stack."
    go home
  end if
  hide bg btn "go back"
  global MAINSCREEN,MAX_LEVEL,JUST_LIST,SpellBGID
  put "From List" into JUST_LIST
  put 9 into MAX_LEVEL
  put the short id of cd "Main Screen" of bg "Magic Stack" into MAINSCREEN
  put the short id of bg "Spells" into SpellBGID
  set the textarrows to true
  set userlevel to 3
  set blindtyping to false
  hide menubar
  hide bg fld "help field"
  set the hilite of bg btn "help" to false
end openStack

function Field_Select
put the clickloc into CLICKEDHERE
put trunc((item 2 of CLICKEDHERE - Top of the target +the scroll of the target) div textHeight of the target) + 1 into theLine

set the locktext of the target to false
click at the left of the target,item 2 of CLICKEDHERE
click at the right of the target-18,item 2 of CLICKEDHERE with shiftkey
set the locktext of the target to true
return theLine
end Field_Select

on work
  show menubar
  set userlevel to 5
  set blindtyping to true
end work
on play
  hide menubar
  set userlevel to 3
  choose browse tool

end play

on closestack
  global MAINSCREEN
  hide bg btn "go back" of cd id MAINSCREEN
  if the freesize of this stack > size of this stack/10 then doMenu "Compact Stack"
end closestack

function Add_List NEW_NAME,NEW_ID,NAME_FIELD,ID_FIELD
put cd fld NAME_FIELD of cd "Lists" into ALPHA_NAMES
put cd fld ID_FIELD of cd "Lists" into ALPHA_LINKS
put 1 into COUNT

put BSearch (NEW_NAME,ALPHA_NAMES) into COUNT

if COUNT is 0 then
  -- put it at the start of the list
  if ALPHA_NAMES is not empty then
    put return before line 1 of ALPHA_NAMES
    put return before line 1 of ALPHA_LINKS
  end if
  put NEW_NAME into line 1 of ALPHA_NAMES
  put NEW_ID into line 1 of ALPHA_LINKS
else
  -- put it within the list
  put return&NEW_NAME after line COUNT of ALPHA_NAMES
  put return&NEW_ID after line COUNT of ALPHA_LINKS
end if
put ALPHA_NAMES into cd fld NAME_FIELD of cd "Lists"
put ALPHA_LINKS into cd fld ID_FIELD of cd "Lists"
end Add_List

function Delete_List SPELL_NAME,SPELL_ID,NAME_FIELD,ID_FIELD
put cd fld NAME_FIELD of cd "Lists" into ALPHA_NAMES
put cd fld ID_FIELD of cd "Lists" into ALPHA_IDS
put 1 into COUNT

put BSearch (SPELL_NAME,ALPHA_NAMES) into COUNT

if line COUNT of ALPHA_NAMES is not SPELL_NAME then
  answer "You have a bad Magic Stack. Contact Me."
else
  if line COUNT of ALPHA_IDS is not SPELL_ID then
    -- move around to find the correct SPELL_ID
    repeat while line (COUNT-1) of ALPHA_NAMES is SPELL_NAME
      subtract 1 from COUNT
    end repeat
    repeat while line COUNT of ALPHA_IDS is not SPELL_ID and line COUNT of ALPHA_NAMES is SPELL_NAME
      add 1 to COUNT
    end repeat
    if line COUNT of ALPHA_NAMES is not SPELL_NAME then
      answer "You have a bad Magic Stack. See Manual."
    end if
  end if
  delete line COUNT of ALPHA_NAMES
  delete line COUNT of ALPHA_IDS
end if
put ALPHA_NAMES into cd fld NAME_FIELD of cd "Lists"
put ALPHA_IDS into cd fld ID_FIELD of cd "Lists"
end Delete_List

function BSearch NAME,NAME_LIST
-- find where NAME is, or if not there, where it should go
-- this returns the line NAME should go AFTER is NAME is not there
put 1 into MIN_BOUND
put the number of lines of NAME_LIST into MAX_BOUND
put trunc((MIN_BOUND+MAX_BOUND)/2) into TEST_SITE
put MIN_BOUND into PREV_SITE
if MAX_BOUND is 0 then
  put 0 into TEST_SITE
else if NAME < line MIN_BOUND of NAME_LIST then
  put MIN_BOUND-1 into TEST_SITE
else if NAME >= line MAX_BOUND of NAME_LIST then
  put MAX_BOUND into TEST_SITE
else repeat until NAME=line TEST_SITE of NAME_LIST or TEST_SITE is PREV_SITE
if NAME>line TEST_SITE of NAME_LIST then
  put TEST_SITE into MIN_BOUND
else
  put TEST_SITE into MAX_BOUND
end if
put TEST_SITE into PREV_SITE
put trunc((MIN_BOUND+MAX_BOUND)/2) into TEST_SITE
end repeat
return TEST_SITE
end BSearch


function Find_Junk WHAT,WHERE,TYPE,TYPE_TO_SEARCH
global NAME_LIST,ID_LIST
put 1 into SPELL_COUNT
repeat while SPELL_COUNT <= the number of lines of ID_LIST
  put line SPELL_COUNT of ID_LIST into SPELL_ID
  if TYPE is not "All Types" then
    put FALSE into KEEP_IT
    put 1 into COUNT
    repeat while COUNT <= the number of lines of TYPE and not KEEP_IT
      put offset(line COUNT of TYPE,bg fld TYPE_TO_SEARCH of cd id SPELL_ID) is not 0 into KEEP_IT
      add 1 to COUNT
    end repeat
  else put TRUE into KEEP_IT
  if KEEP_IT then
    put 1 into COUNT
    if line COUNT of WHERE is "Used By" then
      if line COUNT of WHAT is not "No one" then
        put offset ("Anyone",bg fld (line COUNT of WHERE) of cd id SPELL_ID)is not 0 into KEEP_IT
      end if
      if offset (line COUNT of WHAT,bg fld (line COUNT of WHERE) of cd id SPELL_ID) is not 0 then
        put TRUE into KEEP_IT
      end if
      put 2 into COUNT
    end if
    if KEEP_IT then
      repeat while COUNT<= the number of lines of WHAT and KEEP_IT
        put offset(line COUNT of WHAT,bg fld (line COUNT of WHERE) of cd id SPELL_ID) is not 0 into KEEP_IT
        add 1 to COUNT
      end repeat
    end if
  end if
  if not KEEP_IT then
    delete line SPELL_COUNT of ID_LIST
    delete line SPELL_COUNT of NAME_LIST
  else
    add 1 to SPELL_COUNT
  end if
end repeat
end Find_Junk

function Add_Chooser NEW_NAME,NEW_ID
global MAINSCREEN,CURRENT_CARD
put last char of bg fld "Spell Chooser" of cd id MAINSCREEN into SCH
put last char of cd fld "SpellID" of cd id MAINSCREEN into SID
if SCH is return or (bg fld "Spell Chooser" of cd id MAINSCREEN) is empty then
  put empty into SCH
else
  put return into SCH
end if
if SID is return or (cd fld "SpellID" of cd id MAINSCREEN) is empty then
  put empty into SID
else
  put return into SID
end if
put SCH&NEW_NAME after bg fld "Spell Chooser" of cd id MAINSCREEN
put SID&(the short id of this card) after cd fld "SpellID" of cd id MAINSCREEN
put the number of lines of bg fld "Spell Chooser" of cd id MAINSCREEN into CURRENT_CARD
end Add_Chooser

function AskForLevel
global MAX_LEVEL
put TRUE into REPEATASK
repeat while REPEATASK
  ask "Spell Level?"
  put it into NewLevel
  if NewLevel is empty or NewLevel is "Cancel" then
    put FALSE into REPEATASK
  else if NewLevel < 1 or NewLevel > MAX_LEVEL then
    answer "Level must be from 1 to"&&MAX_LEVEL
  else if length(NewLevel) > 1 then
    answer "I need a number for level."
  else
    put it into NewLevel
    put FALSE into REPEATASK
  end if
end repeat
return NewLevel
end AskForLevel

on ShowHelp TheFIELD,Button
  global MAINSCREEN
  put cd fld TheFIELD of cd id MAINSCREEN into TheHELP
  if TheHELP is not bg fld "Help Field" then
    lock screen
    --set the scroll of bg fld "Help Field" to 0
    put the rect of bg fld "Help Field" into HELPRECT
    if Button is FALSE then
      put the bottom of bg fld TheFIELD into BTNBOTTOM
      put the left of bg fld TheFIELD into BTNLEFT
    else
      put the bottom of bg btn TheFIELD into BTNBOTTOM
      put the left of bg btn TheFIELD into BTNLEFT
    end if
    if BTNBOTTOM > 240 then
      -- set the bottom to the bottom
      add (BTNBOTTOM-item 4 of HELPRECT) to item 2 of HELPRECT
      put BTNBOTTOM into item 4 of HELPRECT
    else
      -- set the top to the top
      add (BTNBOTTOM-item 2 of HELPRECT) to item 4 of HELPRECT
      put BTNBOTTOM into item 2 of HELPRECT
    end if
    if BTNLEFT > 250 then
      -- set the right to the right
      add (BTNLEFT-item 3 of HELPRECT) to item 1 of HELPRECT
      put BTNLEFT into item 3 of HELPRECT
    else
      -- set the left to the left
      add (BTNLEFT-item 1 of HELPRECT) to item 3 of HELPRECT
      put BTNLEFT into item 1 of HELPRECT
    end if
    set the rect of bg fld "Help Field" to HELPRECT
    put TheHELP into bg fld "Help Field"
    unlock screen
    beep
  end if
  show bg fld "Help Field"
end ShowHelp

on cmdkey TheKEY
  answer TheKEY
end cmdkey

on arrowKey
  put the textarrows into ARROWSAVE
  if word 1 of the selectedChunk is "char" then
    set the textarrows to true
    pass arrowKey
  end if
  set the textarrows to ARROWSAVE
end arrowKey


function delField TheField
put the userlevel into SavedLevel
set the userlevel to 5
select cd fld TheField
domenu "clear field"
choose browse tool
set the userlevel to SavedLevel
end delField


-- This imports spells, and will also serve to Update for newer
-- versions of the Magic Stack
on Update OLD_ID,NEW_ID,OLDFIELDS,NEWFIELDS
  repeat with COUNT=1 to the number of lines of OLDFIELDS
    put line COUNT of OLDFIELDS into CURRENT_FIELD
    if IsLineIn(CURRENT_FIELD,NEWFIELDS) then
      put bg fld CURRENT_FIELD of cd id OLD_ID into bg fld CURRENT_FIELD of cd id NEW_ID
    end if

  end repeat
end Update

function IsLineIn TheLine,TheList
put offset(TheLine,TheList) into TheLOC
put space into EndChar
put space into StartChar
if TheLOC is not 0 then
  put return into EndChar
  put return into StartChar

  -- see if the start begins a line
  if TheLOC > 1 then
    put char (TheLOC-1) of TheLIST into StartChar
  end if

  -- see if the end ends a line
  if (TheLOC + length(TheLINE)) < length(TheLIST) then
    put char (TheLOC+length(TheLINE)) of TheLIST into EndChar
  end if
end if
put EndChar is return and StartChar is return into IsThere
return IsThere
end IsLineIn

-- this command adds the current card to the lists of spells
-- don't forget that adding/changing a spell's class(es) does it's own
--      specific version of this, just for the addition
on ADD_THIS_CARD
  put the short id of this card into NEW_ID
  put bg fld "Name" into NEW_NAME
  put bg fld "Level" into NEW_LEVEL
  set the cantdelete of this card to false
  put bg fld "Class" into NEW_CLASS
  repeat with COUNT=1 to the number of items of NEW_CLASS
    put item COUNT of NEW_CLASS into CLASS_NAME
    put CLASS_NAME&"Alphabetical" into NAME_FIELD
    put CLASS_NAME&&"Level"&&NEW_LEVEL into LEVEL_FIELD
    put LEVEL_FIELD&&"IDs" into LEVEL_ID_FIELD
    put CLASS_NAME&"AlphaLinkIDs" into ID_FIELD
    get Add_List(NEW_NAME,NEW_ID,NAME_FIELD,ID_FIELD)
    get Add_List(NEW_NAME,NEW_ID,LEVEL_FIELD,LEVEL_ID_FIELD)
  end repeat
  put "Level"&&NEW_LEVEL into LEVEL_FIELD
  put LEVEL_FIELD&&"IDs" into LEVEL_ID_FIELD
  get Add_List(NEW_NAME,NEW_ID,"Alphabetical","AlphaLinkIDs")
  get Add_List(NEW_NAME,NEW_ID,LEVEL_FIELD,LEVEL_ID_FIELD)
  get Add_Chooser(NEW_NAME,NEW_ID)
end ADD_THIS_CARD

-- make sure all the classes that use this spell exist
-- prompt user to 'add, delete, or replace' if it doesn't
on CHECK_THIS_CARD NewClassList
  global MAINSCREEN,REPLACE_LIST
  put 1 into THERECLASS
  repeat while THERECLASS <= the number of items of bg fld "Class"
    put TRUE into NOPE_NOT_THERE
    put bg fld "Class" into SPELLCLASSES
    put cd fld "Classes" of cd "Lists" into TheCLASSES
    put the number of lines of TheCLASSES into NUMCLASSES
    put 1 into HERECLASS
    repeat while NOPE_NOT_THERE and HERECLASS <= NUMCLASSES
      put (item THERECLASS of SPELLCLASSES) is not (item 1 of (line HERECLASS of TheCLASSES)) into NOPE_NOT_THERE
      add 1 to HERECLASS
    end repeat
    put TRUE into ADDONE
    if NOPE_NOT_THERE then
      -- it doesn't exist
      put item THERECLASS of SPELLCLASSES into GHOSTCLASS
      put Replacements(GHOSTCLASS) into TheCHOICE
      if TheCHOICE is "Not Here" then
        answer "Class"&&GHOSTCLASS&&"does not exist."
        repeat with Count=1 to the number of lines of TheCLASSES -1
          put item 1 of line Count of TheCLASSES into line Count of TheList
        end repeat
        repeat until TheCHOICE is "Create" or TheCHOICE is "Replace" or TheCHOICE is "Delete"
          put empty into TheReplace
          answer "Create, replace, or delete"&&GHOSTCLASS&"?" with "Create" or "Replace" or "Delete"
          put it into TheCHOICE
          if TheCHOICE is "Replace" then
            dolist "Replace","Cancel",TheList,one
            if the result is not empty then
              put item 2 of the result into TheReplace
              put "Replace,"&GHOSTCLASS&","&TheReplace into ADDITION
              put ADDITION into line (the number of lines of REPLACE_LIST+1) of REPLACE_LIST
            else
              put empty into TheCHOICE
            end if
          else if TheCHOICE is "Delete" then
            put "Delete,"&GHOSTCLASS into ADDITION
            put ADDITION into line (the number of lines of REPLACE_LIST+1) of REPLACE_LIST
          end if
        end repeat
        set the cursor to watch
        RenewScreen MAINSCREEN
      else
        put item 2 of TheCHOICE into TheReplace
        delete item 2 of TheCHOICE
      end if
      if TheCHOICE is "Delete" then
        delete item THERECLASS of bg fld "Class"
        put FALSE into ADDONE
      else if TheCHOICE is "Create" then
        Put 1 into NewClassNum
        repeat until (item 1 of line NewClassNum of NewClassList) is GHOSTCLASS or NewClassNum> the number of lines of NewClassList
          add 1 to NewClassNum
        end repeat
        if NewClassNum> the number of lines of NewClassList then
          put "None" into NewType
        else
          put (item 2 of line NewClassNum of NewClassList) into NewType
        end if
        ADD_CLASS GHOSTCLASS,NewType
      else
        -- the choice is replace; replace foreign class with domestic one
        put TheReplace into item THERECLASS of bg fld "Class"
      end if
    end if
    if ADDONE then
      add 1 to THERECLASS
    end if
  end repeat
end CHECK_THIS_CARD

on CLEAR_THIS_CARD
  global CURRENT_CARD,MAINSCREEN
  put the short id of this card into SPELL_ID
  put bg fld "Name" into SPELL_NAME
  put bg fld "Level" into SPELL_LEVEL
  put bg fld "Class" into CLASSES
  repeat with COUNT=1 to the number of items of CLASSES
    put item COUNT of CLASSES into TheCLASS
    put TheCLASS&"Alphabetical" into NAME_FIELD
    put TheCLASS&"AlphaLinkIDs" into ID_FIELD
    put TheCLASS&&"Level"&&SPELL_LEVEL into LEVEL_FIELD
    put LEVEL_FIELD&&"IDs" into LEVEL_ID_FIELD
    get Delete_List(SPELL_NAME,SPELL_ID,NAME_FIELD,ID_FIELD)
    get Delete_List(SPELL_NAME,SPELL_ID,LEVEL_FIELD,LEVEL_ID_FIELD)
  end repeat
  put "Level"&&SPELL_LEVEL into LEVEL_FIELD
  put LEVEL_FIELD&&"IDs" into LEVEL_ID_FIELD
  delete line CURRENT_CARD of bg fld "spell chooser" of cd id MAINSCREEN
  delete line CURRENT_CARD of cd fld "spellid" of cd id MAINSCREEN
  get Delete_List(SPELL_NAME,SPELL_ID,"Alphabetical","AlphaLinkIDs")
  get Delete_List(SPELL_NAME,SPELL_ID,LEVEL_FIELD,LEVEL_ID_FIELD)
end CLEAR_THIS_CARD

on CLEAR_ALL_LISTS
  global MAX_LEVEL
  push card
  go to cd "Lists"
  -- put empty into all
  put empty into cd fld "alphabetical"
  put empty into cd fld "alphalinkids"
  put cd fld "Classes" into CLASSES
  repeat with Count=1 to the number of lines of CLASSES -1
    put item 1 of line Count of CLASSES into TheClass
    put TheClass&"Alphabetical" into TheField
    put empty into cd fld TheField
    put TheClass&"AlphaLinkIDs" into TheField
    put empty into cd fld TheField
  end repeat
  repeat with Count=1 to MAX_LEVEL
    put "Level"&&Count into TheField
    put empty into cd fld TheField
    put TheField&&"IDs" into TheField
    put empty into cd fld TheField
    repeat with ClassNum=1 to the number of lines of CLASSES -1
      put item 1 of line ClassNum of CLASSES into TheClass
      put TheClass&&"Level"&&Count into TheField
      put empty into cd fld TheField
      put TheField&&"IDs" into TheField
      put empty into cd fld TheField
    end repeat
  end repeat
  pop card
end CLEAR_ALL_LISTS

on ADD_CLASS NEW_CLASS,NEW_TYPE
  global CURRENT_CLASS,MAX_LEVEL
  put cd fld "Classes" of cd "Lists" into CLASSES
  if CURRENT_CLASS is the number of lines of CLASSES then add 1 to CURRENT_CLASS
  put last line of CLASSES into ALL_CLASS
  put NEW_CLASS&","&NEW_TYPE into last line of CLASSES
  put linesort( CLASSES) into CLASSES
  if last char of CLASSES is not return then put return after CLASSES
  put ALL_CLASS after CLASSES

  put CLASSES into cd fld "Classes" of cd "Lists"

  -- create sort fields for this class
  set cursor to watch
  lock screen
  push card
  go to cd "Lists"
  put the userlevel into USER_LEVEL_SAVE
  set the userlevel to 4
  put the number of cd flds into FIELD_NUMBER
  add 1 to FIELD_NUMBER
  select cd fld "alphabetical"
  domenu "copy field"
  domenu "paste field"
  set the name of cd fld FIELD_NUMBER to NEW_CLASS&"alphabetical"
  add 1 to FIELD_NUMBER
  select cd fld "alphalinkids"
  domenu "copy field"
  domenu "paste field"
  set the name of cd fld FIELD_NUMBER to NEW_CLASS&"alphalinkids"
  add 1 to FIELD_NUMBER
  repeat with COUNT=1 to MAX_LEVEL
    put "Level"&&COUNT into FIELD_NAME
    select cd fld FIELD_NAME
    domenu "copy field"
    domenu "paste field"
    set the name of cd fld FIELD_NUMBER to NEW_CLASS&&FIELD_NAME
    add 1 to FIELD_NUMBER
    put " IDs" after FIELD_NAME
    select cd fld FIELD_NAME
    domenu "copy field"
    domenu "paste field"
    set the name of cd fld FIELD_NUMBER to NEW_CLASS&&FIELD_NAME
    add 1 to FIELD_NUMBER
  end repeat
  pop card
  choose browse tool
  unlock screen
end ADD_CLASS

on RenewScreen CURTAIN
  push card
  go to cd id CURTAIN
  unlock screen
  lock screen
  pop card
end RenewScreen

on Do_The_Copy
  domenu "Copy Card"
  pop card
  go last
  type "v" with commandKey
end Do_The_Copy

function Replacements IndexClass
global REPLACE_LIST
put 1 into Count
repeat while Count<= the number of lines of REPLACE_LIST and item 2 of line Count of REPLACE_LIST is not IndexClass
  add 1 to Count
end repeat
if Count> the number of lines of REPLACE_LIST then
  put "Not Here" into TheResult
else
  put line Count of REPLACE_LIST into TheResult
  delete item 2 of TheResult
end if
return TheResult
end Replacements